home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / umich / tex / td187src.lzh / UNDO.I < prev    next >
Text File  |  1991-12-14  |  4KB  |  150 lines
  1. IMPLEMENTATION MODULE Undo;
  2.  
  3. FROM Types      IMPORT ObjectPtrTyp, DrawObjectTyp;
  4. FROM SYSTEM     IMPORT ADDRESS , ADR, WORD ;
  5. FROM Storage    IMPORT ALLOCATE , DEALLOCATE;
  6. IMPORT MagicSys ;
  7. IMPORT Variablen;
  8. IMPORT CommonData;
  9.  
  10. VAR LastObject    : ObjectPtrTyp;
  11.     CopyOfObjects : ObjectPtrTyp;
  12.     StoreRef      : ObjectPtrTyp;
  13.     StoreRes      : INTEGER;
  14.     UndoMode      : BOOLEAN;
  15.  
  16. PROCEDURE SwapObjects;
  17. VAR tmp : ObjectPtrTyp; itmp : INTEGER;
  18. BEGIN
  19.   IF CopyOfObjects<>NIL THEN
  20.     itmp := CommonData.InternalResolution;
  21.     CommonData.InternalResolution := StoreRes;
  22.     StoreRes := itmp;
  23.     tmp := Variablen.FirstObject;
  24.     Variablen.FirstObject := CopyOfObjects;
  25.     CopyOfObjects := tmp;
  26.     tmp := Variablen.RefObject;
  27.     Variablen.RefObject := StoreRef;
  28.     StoreRef := tmp;
  29.     tmp := Variablen.FirstObject;
  30.     WHILE tmp^.Next<>NIL DO
  31.       tmp := tmp^.Next;
  32.     END;
  33.     Variablen.LastObject := tmp;
  34.   END;
  35. END SwapObjects;
  36.  
  37. PROCEDURE DeleteCopy;
  38.  
  39.   PROCEDURE DeleteTree(start : ObjectPtrTyp);
  40.   VAR tmp1, tmp2 : ObjectPtrTyp;
  41.   BEGIN
  42.     tmp1 := start;
  43.     WHILE tmp1<>NIL DO
  44.       tmp2 := tmp1^.Next;
  45.       IF (ORD(tmp1^.Code [ 0 ]) = ORD(Picture)) AND
  46.          (tmp1^.Children<>NIL) THEN
  47.         DeleteTree(tmp1^.Children);
  48.       END;
  49.       IF (tmp1^.CPtr<>NIL) AND (tmp1^.Code [ 9 ] > 0) THEN
  50.         DEALLOCATE (tmp1^.CPtr , MagicSys.CastToLCard (tmp1^.Code [ 9 ])) ;
  51.       END;
  52.       IF (tmp1^.EPtr<>NIL) AND (tmp1^.Code [ 3 ] > 0) THEN
  53.         DEALLOCATE (tmp1^.EPtr , 4 * MagicSys.CastToLCard (tmp1^.Code [ 3 ])) ;
  54.       END;
  55.       DISPOSE (tmp1) ;
  56.       tmp1 := tmp2;
  57.     END;
  58.   END DeleteTree;
  59.  
  60. BEGIN
  61.   IF CopyOfObjects<>NIL THEN
  62.     DeleteTree(CopyOfObjects);
  63.   END;
  64.   CopyOfObjects := NIL;
  65.   StoreRef      := NIL;
  66. END DeleteCopy;
  67.  
  68.  
  69. PROCEDURE DuplicateObjects;
  70.  
  71.   PROCEDURE DuplicateTree(treestart, copystart : ObjectPtrTyp);
  72.   VAR tmp1, tmp2 : ObjectPtrTyp; i : INTEGER;
  73.   BEGIN
  74.     tmp1 := copystart;
  75.     tmp2 := treestart;
  76.     REPEAT
  77.       IF tmp2=Variablen.RefObject THEN
  78.         StoreRef := tmp1;
  79.       END;
  80.       tmp1^          := tmp2^;
  81.       tmp1^.CPtr     := NIL;
  82.       tmp1^.EPtr     := NIL;
  83.       tmp1^.Next     := NIL;
  84.       tmp1^.Children := NIL;
  85.  
  86.       IF (ORD(tmp2^.Code [ 0 ]) = ORD(Picture)) AND
  87.          (tmp2^.Children<>NIL) THEN
  88.         NEW(tmp1^.Children);
  89.         DuplicateTree(tmp2^.Children, tmp1^.Children);
  90.       END;
  91.       IF (tmp2^.CPtr<>NIL) AND (tmp2^.Code [ 9 ] > 0) THEN
  92.         ALLOCATE (tmp1^.CPtr , MagicSys.CastToLCard (tmp1^.Code [ 9 ])) ;
  93.         FOR i:=0 TO tmp1^.Code [ 9 ] - 1 DO
  94.           tmp1^.CPtr^[i] := tmp2^.CPtr^[i];
  95.         END;
  96.       END;
  97.       IF (tmp2^.EPtr<>NIL) AND (tmp2^.Code [ 3 ] > 0) THEN
  98.         ALLOCATE (tmp1^.EPtr , 4 * MagicSys.CastToLCard (tmp2^.Code [ 3 ])) ;
  99.         FOR i := 0 TO tmp2^.Code [ 3 ] - 1 DO
  100.           tmp1^.EPtr^[ (2 * i)    ] := tmp2^.EPtr^ [ (2 * i) ] ;
  101.           tmp1^.EPtr^[ (2 * i) + 1] := tmp2^.EPtr^ [ (2 * i) + 1 ] ;
  102.         END;
  103.       END;
  104.       IF tmp2^.Next<>NIL THEN
  105.         NEW(tmp1^.Next);
  106.       END;
  107.       tmp2 := tmp2^.Next;
  108.       tmp1 := tmp1^.Next;
  109.     UNTIL tmp2=NIL;
  110.   END DuplicateTree;
  111.  
  112. BEGIN
  113.   NEW(CopyOfObjects);
  114.   StoreRes := CommonData.InternalResolution;
  115.   StoreRef := NIL;
  116.   DuplicateTree(Variablen.FirstObject, CopyOfObjects);
  117. END DuplicateObjects;
  118.  
  119.  
  120. PROCEDURE PrepareUndo(prepUndo : BOOLEAN);
  121. BEGIN
  122.   IF UndoMode THEN
  123.     DeleteCopy;
  124.     IF prepUndo THEN
  125.       DuplicateObjects;
  126.     END;
  127.   END;
  128. END PrepareUndo;
  129.  
  130. PROCEDURE UndoIt();
  131. BEGIN
  132.   IF UndoMode THEN
  133.     SwapObjects;
  134.   END;
  135. END UndoIt;
  136.  
  137. PROCEDURE SetUndoFeature(On : BOOLEAN);
  138. BEGIN
  139.   UndoMode := On;
  140.   IF NOT UndoMode THEN
  141.     DeleteCopy;
  142.   END;
  143. END SetUndoFeature;
  144.  
  145. BEGIN
  146.   LastObject    := NIL;
  147.   CopyOfObjects := NIL;
  148.   UndoMode      := TRUE;
  149. END Undo.
  150.